home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 18 / fpc103.zip / LEDIT.SEQ < prev    next >
Text File  |  1988-03-28  |  11KB  |  276 lines
  1. \ LEDIT.SEQ     Line Editor Utility                     by Tom Zimmer
  2.  
  3. comment:
  4.  
  5.   Here is a relatively simple editor for editing one line strings.
  6.  
  7.   Support is provided for strings up to 126 characters in length, with
  8. full word and character operations using keypad or WordStar keys as follows:
  9.  
  10.         Ctrl-A                  Left word
  11.         Ctrl-S                  Left character
  12.         Ctrl-D                  Right character
  13.         Ctrl-F                  Right word
  14.         Ctrl-G                  Forward delete
  15.         Ctrl-T                  Word delete
  16.         Ctrl-Y                  Line delete or clear
  17.         Left arrow              Left character
  18.         Ctrl-Left arrow         Left word
  19.         Right arrow             Right character
  20.         Ctrl-Right arrow        Right word
  21.         Home                    Beginning of line
  22.         End                     End of line
  23.         ESC                     Discard changes and leave
  24.         Return/Enter            Save changes and leave
  25.  
  26.   The parameters needed by LINEEDIT are as follows:
  27.  
  28.         lineedit      ( x y a1 n1 --- )
  29.  
  30.                 x = char pos on row,    zero = left edge
  31.                 y = row number,         zero = top line
  32.                 a1 = counted string
  33.                 n1 = edit limit length, maximum value = 126
  34.  
  35.   Here is an example of a command that would edit a line of text in
  36. SAMPLEBUFFER, with a maximum length of 12 characters, at location
  37. row 10 column 5 on the screen.
  38.  
  39.                 5 10 samplebuffer 12 lineedit
  40.  
  41. comment;
  42.  
  43. only forth also definitions
  44. vocabulary leditor
  45. leditor also definitions
  46.  
  47.     variable lenlimit                             \ line edit length limit
  48.     variable editsource                           \ where the data came from
  49.     variable insertmode                           \ insert/overwrite mode flag
  50.     variable saveflg                              \ are we saving the results
  51.   0 constant ecursor                              \ edit cursor position
  52.   0 constant ex                                   \ where we are editing X
  53.   0 constant ey                                   \ where we are editing Y
  54. 126 constant maxedit
  55.     variable editbuf maxedit 2+ allot             \ our edit buffer, 126 max
  56.              editbuf off
  57.  
  58. : .ecursor      ( --- )
  59.                 ex ecursor + ey at ;            \ show the cursor
  60.  
  61. : .eline        ( --- )                         \ redisplay edit line
  62.                 ex ey at
  63.                 editbuf count qtype
  64.                 lenlimit @ editbuf c@ - 0 max spaces ;
  65.  
  66. : ?char         ( c1 --- false | c1 )   \ handle normal keys, insert them
  67.                 dup bl '~' between
  68.                 if      insertmode @
  69.                         if      editbuf 1+ ecursor + dup 1+
  70.                                 maxedit ecursor - cmove>
  71.                                 editbuf c@ 1+ lenlimit c@ min editbuf c!
  72.                         then
  73.                         editbuf 1+ ecursor + c!
  74.                         ecursor 1+ lenlimit @ min =: ecursor
  75.                         ecursor editbuf c@ max editbuf c!
  76.                         0 2r> 2drop
  77.                 then    ;
  78.  
  79. : dohome        ( --- )                         \ beginning of line
  80.                 0 =: ecursor ;
  81.  
  82. : doend         ( --- )                         \ End of line
  83.                 editbuf c@ =: ecursor ;
  84.  
  85. : doright       ( --- )                         \ right a character
  86.                 ecursor 1+ editbuf c@ min =: ecursor ;
  87.  
  88. : doleft        ( --- )                         \ left a character
  89.                 ecursor 1- 0 max =: ecursor ;
  90.  
  91. : <edone>       ( false --- true )      \ flag edit is finished, save changes
  92.                 0= saveflg on ;
  93.  
  94. : <equit>       ( false --- true )      \ flag edit is finished, discard chngs
  95.                 0= saveflg off ;
  96.  
  97. : <doldel>      ( --- )                         \ Line delete
  98.                 0 editbuf c!
  99.                 0 =: ecursor ;
  100.  
  101. defer doret     ' <edone> is doret
  102. defer dotab     ' <edone> is dotab
  103. defer edone     ' <edone> is edone
  104. defer equit     ' <equit> is equit
  105. defer dopgup    ' beep is dopgup
  106. defer dopgdn    ' beep is dopgdn
  107. defer doup      ' beep is doup
  108. defer dodown    ' beep is dodown
  109. defer doldel    ' <doldel> is doldel
  110.  
  111. : dofdel        ( --- )                         \ Forward delete
  112.                 ecursor 1+ editbuf c@ max editbuf c!
  113.                 editbuf 1+ ecursor + dup 1+ swap maxedit ecursor - cmove
  114.                 -1 editbuf c+! ;
  115.  
  116. : >to=bl        ( --- )                         \ forward to a blank
  117.                 editbuf 1+ dup maxedit + swap ecursor +
  118.                 ?do     i c@ bl = ?leave
  119.                         1 +!> ecursor
  120.                 loop    editbuf c@ ecursor min =: ecursor ;
  121.  
  122. : >to<>bl       ( --- )                         \ forward to a non blank
  123.                 editbuf 1+ dup maxedit + swap ecursor +
  124.                 ?do     i c@ bl <> ?leave
  125.                         1 +!> ecursor
  126.                 loop    editbuf c@ ecursor min =: ecursor ;
  127.  
  128. : dorword       ( --- )                         \ Forward to next word
  129.                 >to=bl
  130.                 >to<>bl ;
  131.  
  132. : <to=bl+1      ( --- )                         \ back to char following BL
  133.                 ecursor 1- 0 max =: ecursor
  134.                 editbuf 1+ dup ecursor + 1- editbuf 1+ max
  135.                 ?do     i c@ bl = ?leave
  136.                         -1 +!> ecursor
  137.             -1 +loop    ;
  138.  
  139. : <to<>bl       ( --- )                         \ Back to non blank
  140.                 ecursor 1- 0 max =: ecursor
  141.                 editbuf 1+ dup ecursor + 1- editbuf 1+ max
  142.                 ?do     i c@ bl <> ?leave
  143.                         -1 +!> ecursor
  144.                 loop    ;
  145.  
  146. : dolword       ( --- )                         \ back a word
  147.                 <to<>bl
  148.                 <to=bl+1 ;
  149.  
  150. : dobdel        ( --- )                         \ back delete
  151.                 ecursor editbuf c@ max editbuf c!
  152.                 ecursor         ( --- f1 )
  153.                 doleft
  154.     ( --- f1 )  if      dofdel
  155.                 then    ;
  156.  
  157. : dowdel        ( --- )                         \ word delete
  158.                 begin   ecursor editbuf c@ <
  159.                         editbuf 1+ ecursor + c@ bl <> and
  160.                 while   dofdel
  161.                 repeat
  162.                 begin   ecursor editbuf c@ <
  163.                         editbuf 1+ ecursor + c@ bl = and
  164.                 while   dofdel
  165.                 repeat  ;
  166.  
  167. : strip_bl's    ( --- )                         \ strip blanks from editbuf
  168.                 ecursor >r
  169.                 doend
  170.                 begin   doleft
  171.                         editbuf 1+ ecursor + c@ bl =
  172.                         ecursor 0<> and
  173.                 while   dofdel
  174.                 repeat  editbuf c@ r> min 0 max =: ecursor ;
  175.  
  176. : doins         ( --- )                         \ toggle insert mode
  177.                 insertmode @ 0= dup insertmode !
  178.                 if      big-cursor
  179.                 else    norm-cursor
  180.                 then    ;
  181.  
  182. : ?control      ( c1 --- bool | c1 )    \ handle control characters
  183.                 dup bl <
  184.                 if      2r> 2drop
  185.                         false
  186.                         swap
  187.                         31 min exec:
  188.  
  189. \                       0 null  1 a     2 b     3 c     4 d     5 e     6 f
  190.                         beep    dolword beep    dopgdn  doright doup  dorword
  191.  
  192. \                       7 g     8 h     9 i     LF      11 k    12 l    Enter
  193.                         dofdel  dobdel  dotab   beep    beep    beep    doret
  194.  
  195. \                       14 n    15 o    16 p    17 q    18 r    19 s    20 t
  196.                         beep    beep    beep    beep    dopgup  doleft  dowdel
  197.  
  198. \                       21 u    22 v    23 w    24 x    25 y    26 z    Esc
  199.                         beep    doins   beep    dodown  doldel  beep    equit
  200.  
  201. \                       28 \    29 ]    30 ^    31 _
  202.                         beep    beep    beep    beep
  203.                 then    ;
  204.  
  205. : ?func         ( c1 --- bool | c1 )    \ handle function keys
  206.                 dup 127 >
  207.                 if      2r> 2drop
  208.                         false
  209.                         over 243 244 between    \ ctrl-left, or ctrl-right
  210.                    if   swap 243 =
  211.                         if      dolword         \ left  word
  212.                         else    dorword         \ right word
  213.                         then
  214.                    else swap 198 - 0 max 14 min
  215.                         exec:
  216.  
  217. \                       198     Home    Up      PgUp    202     Left    204
  218.                         beep    dohome  doup    dopgup  beep    doleft  beep
  219.  
  220. \                       Right   206     End     Down    PgDn    Insert  Delete
  221.                         doright beep   doend    dodown  dopgdn  doins   dofdel
  222.  
  223. \                       212
  224.                         beep
  225.                    then
  226.                 then    ;
  227.  
  228.                                                 \ c1 = keyboard character
  229.                                                 \ f1 = true for done editing
  230. : dokey         ( c1 --- f1 )                   \ process a key
  231.                 ?char                           \ handle normal ascii
  232.                 ?func                           \ function characters
  233.                 ?control                        \ control chars
  234.                 drop beep 0 ;
  235.  
  236.                                                 \ x = char pos on row
  237.                                                 \ y = line number
  238.                                                 \ a1 = counted string
  239.                                                 \ n1 = edit limit length
  240. : <ledit>       ( x y a1 n1 --- )       \ Edit line currently in EDITBUF.
  241.                 over c@ ecursor min =: ecursor
  242.                 maxedit min lenlimit !          \ set edit length limit val
  243.                 dup editsource !
  244.                 editbuf over c@ 1+ lenlimit @ 1+ min cmove
  245.                 editbuf c@ lenlimit @ min editbuf c!
  246.                 =: ey =: ex                     \ save origin
  247.                 begin   .eline
  248.                         .ecursor key dokey      ( --- f1 )
  249.                 until   saveflg @               \ proper save exit
  250.                 if      strip_bl's
  251.                         editbuf
  252.                         editsource @ over c@ 1+ lenlimit @ 1+ min cmove
  253.                 then    ;
  254.  
  255. forth definitions
  256.                                                 \ x = char pos on row
  257.                                                 \ y = line number
  258.                                                 \ a1 = counted string
  259.                                                 \ n1 = edit limit length
  260. : lineedit      ( x y a1 n1 --- )               \ Edit line in a1
  261.                 0 =: ecursor
  262.                 insertmode off
  263.                 <ledit> ;
  264.  
  265. only forth also definitions
  266.  
  267. \s
  268.  
  269. variable samplebuffer 128 allot
  270.  
  271. : sample        ( --- )
  272.                 " Zimmer, Harold" ">$
  273.                 samplebuffer over c@ 1+ cmove
  274.                 27 04 samplebuffer 24 lineedit ;
  275.  
  276.